home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pascala.zip / SORT.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-06  |  5KB  |  161 lines
  1. (*************************************)
  2. (* Alejo Alamillo             *)
  3. (* Spring 1991                 *)
  4. (* Assignment: Compsort          *)
  5. (* COSC 055                 *)
  6. (*************************************)
  7.  
  8. (*******************************************************)
  9. (*  Compsorts is a program which uses several          *)
  10. (*  sorting methods and compares their execution times *)
  11. (*  The main program and Shellsort are to be completed *)
  12. (*        PRB  10/23/90                                *)
  13. (*******************************************************)
  14. PROGRAM Compsorts(Input,Output,File1);
  15.  
  16. CONST MaxSize = 8192;
  17. TYPE  ArrayType = ARRAY[0..MaxSize] OF Integer;
  18. VAR B,C,D,E,F: ArrayType;
  19.     StartTime, EndTime, Size: Integer;
  20.     File1: Text;
  21. (**************************************************)
  22. (*  Bubble Sort                                   *)
  23. (**************************************************)
  24.   PROCEDURE BubbleSort(VAR A: ArrayType; Size: Integer);
  25.   VAR I, Pass, Temp: Integer;
  26.       NoExchg:  Boolean;
  27.  
  28.   BEGIN
  29.   Pass:= 0;
  30.   REPEAT
  31.     NoExchg:= True;
  32.     Pass:= Pass + 1;
  33.     FOR I:= 1 TO Size - Pass DO
  34.       IF A[I] < A[I+1] THEN
  35.         BEGIN
  36.         Temp:= A[I];
  37.         A[I]:= A[I+1];
  38.         A[I+1]:= Temp;
  39.         NoExchg:= False;
  40.         END;
  41.   UNTIL Noexchg OR (Pass = Size-1);
  42.   END;
  43. (***********************************************************)
  44. (*  Selection sort--find the smallest element and place it *)
  45. (***********************************************************)
  46. PROCEDURE SelectSort(VAR A: ArrayType; Size: Integer);
  47.  
  48.   VAR Pass, I, J, K, S: Integer;
  49.  
  50.   BEGIN
  51.   FOR Pass:= 1 TO Size DO
  52.     BEGIN
  53.     K:= Pass;  (* Points to location of smallest remaining entry *)
  54.     S:= A[K];
  55.     FOR I:= Pass + 1 TO Size DO   (* Find smallest      "       "   *)
  56.       IF A[I] < S THEN
  57.         BEGIN
  58.         S:= A[I];
  59.         K:= I;
  60.         END;
  61.     A[K]:= A[Pass];
  62.     A[Pass]:= S;      (* Switch *)
  63.     END;  (* Pass *)
  64.   END;
  65. (***********************************************************)
  66. (*  Insertion Sort  (Refined)                              *)
  67. (*  Assumes a 'stopper--impossibly small' at entry zero    *)
  68. (***********************************************************)
  69.   PROCEDURE InsertSort(VAR A: ArrayType; Size: Integer);
  70.     VAR  Pass, I, S:  Integer;
  71.     BEGIN
  72.     FOR Pass:= 2 TO Size DO  (* Insert item 'Pass' *)
  73.       BEGIN
  74.       I:= Pass;
  75.       S:= A[Pass];   (* Copy item to be inserted *)
  76.       WHILE S < A[I-1] DO
  77.         BEGIN
  78.         A[I]:= A[I-1]; (* Move item down in list *)
  79.         I:= I-1;
  80.         END;
  81.       A[I]:= S;  (* Perform Insertion *)
  82.       END;
  83.     END;
  84.  
  85. (*********************************************************)
  86. (*  ShellSort-- Currently a stub                         *)
  87. (*********************************************************)
  88. PROCEDURE ShellSort(VAR A: ArrayType; Size:Integer);
  89.   BEGIN
  90.   Writeln('ShellSort here--only a stub!');
  91.   END;
  92.  
  93. (*********************************************************)
  94. (*  QuickSort-- Recursive version                        *)
  95. (*********************************************************)
  96.   PROCEDURE QuickSort(VAR A: ArrayType; Size:Integer);
  97.  
  98.     PROCEDURE Sort(L,R: Integer);
  99.       VAR Temp, I, J, StartValue: Integer;
  100.       BEGIN
  101.       I:= L;
  102.       J:= R;
  103.       StartValue:= A[(L+R) DIV 2];
  104.       REPEAT
  105.         WHILE A[I] < StartValue DO  (* Search from left *)
  106.           I:= I+1;
  107.         WHILE A[J] > StartValue DO (* Search from right *)
  108.           J:= J-1;
  109.         IF I<=J THEN
  110.           BEGIN
  111.           Temp:= A[I];
  112.           A[I]:= A[J];
  113.           A[J]:= Temp;
  114.           I:= I+1;
  115.           J:= J-1;
  116.           END;
  117.       UNTIL  I >= J;
  118.       IF L < J THEN Sort(L,J);
  119.       IF I < R THEN Sort(I,R);
  120.     END;  (* Sort *)
  121.   BEGIN
  122.   Sort(1, Size);
  123.   END;
  124.  
  125.  
  126. BEGIN   (*******************  MAIN  ***********************)
  127. Reset(File1);
  128. B[0]:= 0;    (* Bumper for top of list *)
  129. Size:= 0;
  130. WHILE not Eof(File1) DO
  131.   BEGIN
  132.   Size:= Size + 1;
  133.   Readln(File1,B[Size]);
  134.   END;
  135. C:= B; D:= B; E:= B; F:= B;
  136.  
  137. Writeln('Array Size: ',Size:0);
  138. Writeln;
  139.  
  140. StartTime:= Clock;
  141. BubbleSort(B, Size);
  142. EndTime:= Clock;
  143. Writeln('BubbleTime: ',EndTime-StartTime:0);
  144.  
  145. StartTime:= Clock;
  146. SelectSort(C,Size);
  147. EndTime:= Clock;
  148. Writeln('SelectTime: ',EndTime-StartTime:0);
  149.  
  150. StartTime:= Clock;
  151. InsertSort(D, Size);
  152. EndTime:= Clock;
  153. Writeln('InsertTime: ',EndTime-StartTime:0);
  154.  
  155. StartTime:= Clock;
  156. QuickSort(F, Size);
  157. EndTime:= Clock;
  158. Writeln('QuickTime:  ',EndTime-StartTime:0);
  159.  
  160. END.     (****************  COMPSORTS  **********************)
  161.